home *** CD-ROM | disk | FTP | other *** search
/ PD Collection CD 1 / PD Collection CD 1.iso / programer2 / pari2 / pari / other / plot_sun < prev    next >
Encoding:
Text File  |  1991-05-13  |  6.0 KB  |  181 lines
  1. /*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/
  2. /*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/
  3. /*                                                                 */
  4. /*                     PLOT EN HAUTE RESOLUTION                    */
  5. /*                                                                 */
  6. /*                       copyright Babe Cool                       */
  7. /*                                                                 */
  8. /*                                                                 */
  9. /*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/
  10. /*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*/
  11.  
  12. # include "genpari.h"
  13.  
  14. #include        <suntool/sunview.h>
  15. #include        <suntool/canvas.h>
  16. #include        <suntool/textsw.h>
  17. #include        <suntool/panel.h>
  18.  
  19. GEN  ploth(ep,a,b,ch)
  20.      entree *ep;
  21.      GEN a,b;
  22.      char *ch;   
  23.  
  24. #define ISCR 1120 /* 1400 en haute resolution */     
  25. #define JSCR 800  /* 1120 en haute resolution */     
  26. #define DECI 100  /* 140 en haute resolution  */
  27. #define DECJ  50  /* 70 en haute resolution   */
  28.  
  29. {
  30.   long av,av2,jz,j,j1,i,sig,is,is2,js,js2;
  31.   GEN p1,p2,ysml,ybig,x,diff,dyj,dx,y[ISCR+1];
  32.   char c1[20];
  33.   char *c2;
  34.   Frame ecran;
  35.   Canvas canevas;
  36.   Pixwin *pw;
  37.   Pixfont *font;
  38.  
  39.   ecran=window_create(NULL,FRAME,FRAME_LABEL,"ploth",
  40.                       WIN_ERROR_MSG,"you must be in suntools",0);
  41.   canevas=window_create(ecran,CANVAS,WIN_HEIGHT,JSCR,
  42.                         WIN_WIDTH,ISCR,0);
  43.   window_fit(ecran);pw=canvas_pixwin(canevas);
  44.   is=ISCR-DECI;js=JSCR-DECJ;is2=is-DECI;js2=js-DECJ;
  45.   pw_vector(pw,DECI,DECJ,DECI,js,PIX_SRC,1);
  46.   pw_vector(pw,DECI,DECJ,is,DECJ,PIX_SRC,1);
  47.   pw_vector(pw,is,DECJ,is,js,PIX_SRC,1);
  48.   pw_vector(pw,DECI,js,is,js,PIX_SRC,1);
  49.  
  50.   sig=gcmp(b,a); if(!sig) return gnil;
  51.   av=avma;
  52.   if(sig<0) {x=a;a=b;b=x;}
  53.   for(i=1;i<=is2;i++) y[i]=cgetr(3);
  54.   newvalue(ep,cgetr(3)); x=(GEN)ep->value; gaffect(a,x);
  55.   dx=gdivgs(gsub(b,a),is2-1);ysml=gzero;ybig=gzero;
  56.   av2=avma;
  57.   for(i=1;i<=is2;i++)
  58.   {
  59.     gaffect(lisexpr(ch),y[i]);
  60.     if(gcmp(y[i],ysml)<0) ysml=y[i];
  61.     if(gcmp(y[i],ybig)>0) ybig=y[i];
  62.     gaddz(x,dx,x);avma=av2;
  63.   }
  64.   diff=gsub(ybig,ysml);
  65.   if(gcmp0(diff)) {ybig=gaddsg(1,ybig);diff=gun;}
  66.   dyj=gdivsg(js2-1,diff);jz=js+itos(ground(gmul(ysml,dyj)));
  67.   pw_vector(pw,DECI,jz,is,jz,PIX_SRC,1);
  68.   if(gsigne(a)*gsigne(b)<0)
  69.   {
  70.     jz=1-itos(ground(gdiv(a,dx)))+DECI;
  71.     pw_vector(pw,jz,DECJ,jz,js,PIX_SRC,1);
  72.   }
  73.   av2=avma;
  74.   for(i=1;i<=is2;i++)
  75.   {
  76.     j1=js-itos(ground(gmul(gsub(y[i],ysml),dyj)));
  77.     if(i==1) j=j1;
  78.     else
  79.     {
  80.       pw_vector(pw,i-2+DECI,j,i-1+DECI,j1,PIX_SRC,1);j=j1;
  81.     }
  82.     avma=av2;
  83.   }
  84.   font=pw_pfsysopen();
  85.   p1=cgetr(4);gaffect(ysml,p1);c2=(char *)sprintf(c1," %9.3lf ",rtodbl(p1));
  86.   for(i=1;c2[i];i++) pw_char(pw,-4+9*i,js,PIX_SRC,font,c2[i]);
  87.   gaffect(ybig,p1);c2=(char *)sprintf(c1," %9.3lf ",rtodbl(p1));
  88.   for(i=1;c2[i];i++) pw_char(pw,-4+9*i,DECJ,PIX_SRC,font,c2[i]);
  89.   gaffect(a,p1);c2=(char *)sprintf(c1," %9.3lf ",rtodbl(p1));
  90.   for(i=1;c2[i];i++) pw_char(pw,DECI-45+9*i,js+20,PIX_SRC,font,c2[i]);
  91.   gaffect(b,p1);c2=(char *)sprintf(c1," %9.3lf ",rtodbl(p1));
  92.   for(i=1;c2[i];i++) pw_char(pw,is-45+9*i,js+20,PIX_SRC,font,c2[i]);
  93.   avma = av;
  94.   window_main_loop(ecran);
  95.   killvalue(ep);
  96.   return gnil;
  97. }
  98. GEN  ploth2(ep,a,b,ch)
  99.      entree *ep;
  100.      GEN a,b;
  101.      char *ch;   
  102.  
  103. #define ISCR 1120 /* 1400 en haute resolution */     
  104. #define JSCR 800  /* 1120 en haute resolution */     
  105. #define DECI 100  /* 140 en haute resolution  */
  106. #define DECJ  50  /* 70 en haute resolution   */
  107.  
  108. {
  109.   long av,av2,jz,iz,k1,k,j,j1,i,sig,is,is2,js,js2;
  110.   GEN p1,p2,ysml,ybig,xsml,xbig,diffx,diffy,dxj,t,dyj,dt,y[ISCR+1],x[ISCR+1];
  111.   char c1[20];
  112.   char *c2;
  113.   Frame ecran;
  114.   Canvas canevas;
  115.   Pixwin *pw;
  116.   Pixfont *font;
  117.  
  118.   ecran=window_create(NULL,FRAME,FRAME_LABEL,"ploth",
  119.                       WIN_ERROR_MSG,"you must be in suntools",0);
  120.   canevas=window_create(ecran,CANVAS,WIN_HEIGHT,JSCR,
  121.                         WIN_WIDTH,ISCR,0);
  122.   window_fit(ecran);pw=canvas_pixwin(canevas);
  123.   is=ISCR-DECI;js=JSCR-DECJ;is2=is-DECI;js2=js-DECJ;
  124.   pw_vector(pw,DECI,DECJ,DECI,js,PIX_SRC,1);
  125.   pw_vector(pw,DECI,DECJ,is,DECJ,PIX_SRC,1);
  126.   pw_vector(pw,is,DECJ,is,js,PIX_SRC,1);
  127.   pw_vector(pw,DECI,js,is,js,PIX_SRC,1);
  128.  
  129.   sig=gcmp(b,a); if(!sig) return gnil;
  130.   av=avma;
  131.   if(sig<0) {p1=a;a=b;b=p1;}
  132.   for(i=1;i<=is2;i++) {x[i]=cgetr(3);y[i]=cgetr(3);}
  133.   newvalue(ep,cgetr(3)); t=(GEN)ep->value; gaffect(a,t);
  134.   dt=gdivgs(gsub(b,a),is2-1);ysml=ybig=xsml=xbig=gzero;
  135.   av2=avma;
  136.   for(i=1;i<=is2;i++)
  137.   {
  138.     p1=lisexpr(ch);gaffect(p1[1],x[i]);gaffect(p1[2],y[i]);
  139.     if(gcmp(y[i],ysml)<0) ysml=y[i];
  140.     if(gcmp(y[i],ybig)>0) ybig=y[i];
  141.     if(gcmp(x[i],xsml)<0) xsml=x[i];
  142.     if(gcmp(x[i],xbig)>0) xbig=x[i];
  143.     gaddz(t,dt,t);avma=av2;
  144.   }
  145.   diffy=gsub(ybig,ysml);
  146.   if(gcmp0(diffy)) {ybig=gaddsg(1,ybig);diffy=gun;}
  147.   diffx=gsub(xbig,xsml);
  148.   if(gcmp0(diffx)) {xbig=gaddsg(1,xbig);diffx=gun;}
  149.   dyj=gdivsg(js2-1,diffy);jz=js+itos(ground(gmul(ysml,dyj)));
  150.   dxj=gdivsg(is2-1,diffx);iz=DECI-itos(ground(gmul(xsml,dxj)));
  151.   if(gsigne(ysml)*gsigne(ybig)<0)
  152.     pw_vector(pw,DECI,jz,is,jz,PIX_SRC,1);
  153.   if(gsigne(xsml)*gsigne(xbig)<0)
  154.     pw_vector(pw,iz,DECJ,iz,js,PIX_SRC,1);
  155.   av2=avma;
  156.   for(i=1;i<=is2;i++)
  157.   {
  158.     j1=js-itos(ground(gmul(gsub(y[i],ysml),dyj)));
  159.     k1=DECI+itos(ground(gmul(gsub(x[i],xsml),dxj)));
  160.     if(i==1) {j=j1;k=k1;}
  161.     else
  162.     {
  163.       pw_vector(pw,k,j,k1,j1,PIX_SRC,1);j=j1;k=k1;
  164.     }
  165.     avma=av2;
  166.   }
  167.   font=pw_pfsysopen();
  168.   p1=cgetr(4);gaffect(ysml,p1);c2=(char *)sprintf(c1," %9.3lf ",rtodbl(p1));
  169.   for(i=1;c2[i];i++) pw_char(pw,-4+9*i,js,PIX_SRC,font,c2[i]);
  170.   gaffect(ybig,p1);c2=(char *)sprintf(c1," %9.3lf ",rtodbl(p1));
  171.   for(i=1;c2[i];i++) pw_char(pw,-4+9*i,DECJ,PIX_SRC,font,c2[i]);
  172.   gaffect(xsml,p1);c2=(char *)sprintf(c1," %9.3lf ",rtodbl(p1));
  173.   for(i=1;c2[i];i++) pw_char(pw,DECI-45+9*i,js+20,PIX_SRC,font,c2[i]);
  174.   gaffect(xbig,p1);c2=(char *)sprintf(c1," %9.3lf ",rtodbl(p1));
  175.   for(i=1;c2[i];i++) pw_char(pw,is-45+9*i,js+20,PIX_SRC,font,c2[i]);
  176.   avma = av;
  177.   window_main_loop(ecran);
  178.   killvalue(ep);
  179.   return gnil;
  180. }
  181.